NBA Connections: PUG Blog Post

## 
## ── Column specification ────────────────────────────────────────────────────────
## cols(
##   .default = col_double(),
##   Team = col_character(),
##   Player = col_character(),
##   College = col_character(),
##   Player_URL = col_character(),
##   Img_URL = col_character(),
##   HS = col_character()
## )
## ℹ Use `spec()` for the full column specifications.

## 
## ── Column specification ────────────────────────────────────────────────────────
## cols(
##   player = col_character(),
##   college = col_character(),
##   Team = col_character(),
##   Year = col_double(),
##   Player_URL = col_character(),
##   HS = col_character()
## )

#build prelim college network
draft_college <- draft %>%
  select(College, Player)

college_graph <- graph_from_data_frame(draft_college, directed = FALSE)

college_ntwrk <- ggnetwork(college_graph)

ggplot(data = college_ntwrk
       , aes(x = x, y = y, xend = xend, yend = yend)) +
  geom_edges(arrow=arrow(type="closed", length=unit(6,"pt"))
            , color = "lightgray") +
  geom_nodes() +
  # geom_nodelabel(aes(label = name)) +
  theme_blank()

diameter(college_graph)

## [1] 4

vcount(college_graph)

## [1] 831

ecount(college_graph)

## [1] 693

####HOW CONNECTED NBA TEAMS ARE

set.seed(2000)

#build prelim nba network
draft_nba <- players %>%
  filter(Year == 2019) %>%
  select(player, Team, Year)
  # filter(Team == "BOS" )

nba_graph <- graph_from_data_frame(draft_nba, directed = FALSE)

nba_ntwrk <- ggnetwork(nba_graph)

ggplot(data = nba_ntwrk
       , aes(x = x, y = y, xend = xend, yend = yend)) +
  geom_edges(arrow=arrow(type="closed", length=unit(6,"pt"))
            , color = "lightgray") +
  geom_nodes() +
  geom_nodelabel(aes(label = name)) +
  theme_blank()

diameter(nba_graph)

## [1] 8

vcount(nba_graph)

## [1] 290

ecount(nba_graph)

## [1] 1068

#build prelim hs network
draft_hs <- draft %>%
  # filter(Draft_Year > 2019) %>%
  select(HS, Player, Pick)

hs_graph <- graph_from_data_frame(draft_hs, directed = FALSE)

hs_ntwrk <- ggnetwork(hs_graph)

ggplot(data = hs_ntwrk
       , aes(x = x, y = y, xend = xend, yend = yend)) +
  geom_edges(arrow=arrow(type="closed", length=unit(6,"pt"))
            , color = "lightgray") +
  geom_nodes() +
  # geom_nodelabel(aes(label = name)) +
  theme_blank()

diameter(hs_graph)

## [1] 2

vcount(hs_graph)

## [1] 1285

ecount(hs_graph)

## [1] 693

####NBA PLAYERS BY YR

set.seed(2001)

#build prelim nba network
draft_nba1 <- players %>%
  select(player, Team, Year) %>%
  filter(Year == "2010" )

nba_graph1 <- graph_from_data_frame(draft_nba1, directed = FALSE)

nba_ntwrk1 <- ggnetwork(nba_graph1)

ggplot(data = nba_ntwrk1
       , aes(x = x, y = y, xend = xend, yend = yend)) +
  geom_edges(arrow=arrow(type="closed", length=unit(6,"pt"))
            , color = "lightgray") +
  geom_nodes() +
  geom_nodelabel(aes(label = name)) +
  theme_blank()

diameter(nba_graph1)

## [1] 12

vcount(nba_graph1)

## [1] 257

ecount(nba_graph1)

## [1] 965

set.seed(001)
draft_nba <- players %>%
  select(player, Team, Year) 

nba_graph <- graph_from_data_frame(draft_nba, directed = FALSE)

nba_ntwrk <- ggnetwork( nba_graph )
nba_ntwrk$tooltip <- paste0("Player = ", nba_ntwrk$name)
  
gg_point_1 <- ggplot(data = nba_ntwrk
       , aes(x = x, y = y, xend = xend, yend = yend, tooltip = tooltip)) +
  geom_edges(color = "grey50") +
  geom_nodes(color = "orange", size = 4) +
  theme_blank() +
  # geom_nodetext(aes(label = name)) +
  geom_point_interactive(size=1)

# htmlwidget call
ggiraph(code = {print(gg_point_1)})